home *** CD-ROM | disk | FTP | other *** search
/ Aminet 28 / Aminet 28 (1998)(GTI - Schatztruhe)[!][Dec 1998].iso / Aminet / comm / mmgr / MM_ShoveMsgs06.lha / Rexx / MM_ShoveMsgs.rexx.cmp < prev    next >
Encoding:
Text File  |  1997-07-28  |  7.7 KB  |  22 lines
  1. /*
  2.  
  3.                         $VER: MM_ShoveMsgs  0.6/c  (28-7-97)
  4.  
  5.                             ©1997 Neil Williams
  6.  
  7. */
  8.  
  9. /* Compressed with CompressRexx v2.1, (C) 1993-96 Robert Hofmann */
  10. parse arg args;options cache;options failat 99;options results;signal on break_c;signal on break_d;signal on break_e;signal on break_f;signal on halt;signal on ioerr;signal on syntax;address 'MAILMANAGER';Main:;call Init;call Header;call Read_Cfg;do i = 1 to config.count;call ShoveMsgs(i);end;call Quit(0, 'All done.');exit;break_c:; break_d:; break_e:; break_f:; halt:;signal off break_c;signal off break_d;signal off break_e;signal off break_f;signal off halt;return_code = 5;error_line = 0;error_msg = 'Execution halted!!!';rc = 0;signal Exit;Exit:;select;when return_code>=40 then error = 'INTERNAL-ERROR:';when return_code>=30 then error = 'IO-ERROR:';when return_code>=20 then error = 'ERROR:';when return_code>=10 then error = 'WARNING:';when return_code>=5 then error = 'INFO:';otherwise error = '';end;call Log();call Log('***' strip(error error_msg) '***', '+');call Log(,'\');call setclip('MM_LogPre', system.mm.logpre);exit return_code;Get_Arg: procedure Expose args system.;arg keyword
  11. , mode, old
  12. uargs = upper(args);p = find(uargs, keyword);if p=0 then do;p = pos(' 'keyword'=', ' 'uargs);if p>0 then args = overlay(' ', args, p+length(keyword));p = find(upper(args), keyword);end;system.cmdopt.keyword = p>0;select;when mode=0 then if p>0 then do;ret = 1;args = delword(args, p, 1);end;else ret = old;when mode=1 then if p>0 then do;left = subword(args, 1, p-1);rest = subword(args, p+1);if left(rest, 1)='"' then parse var rest . '"' ret '"' rest;else parse var rest ret rest;args = strip(left strip(rest));end;else ret = old;when mode=2 then do;if left(args, 1)='"' then parse var args . '"' ret '"' args;else parse var args ret args;if strip(ret)='' then ret = old;end;otherwise exit 99;end;args = strip(args);ret = strip(ret, 'b', '" ');return ret;Get_Version: procedure;parse arg mode;parse value sourceline(3-mode) with . . ver .;parse var ver tst 'ß' .;if ~datatype(strip(tst, 'b', '/c '), 'N') then if ~mode then ver = Get_Version(1);else exit 99;return ver;Header:;call Log(,'/')
  13. call Log('***' system.prg.id '***', '+');call Log(' 'system.prg.cr);call Log();return;Init:;system. = 0;system.prg.ver = Get_Version(0);system.prg.name = 'MM_ShoveMsgs';system.prg.id = system.prg.name 'v'system.prg.ver;system.prg.cfg = 'MM:Config/'system.prg.name'.cfg';system.prg.cr = '(C)1997 Neil Williams';system.tmpfile = 'T:'system.prg.name'.tmp';system.mm.logpre = getclip('MM_LogPre');system.prg.logpre = system.mm.logpre'|';call setclip('MM_LogPre', system.prg.logpre);system.prg.loglevel = 3;call Include_Lib('rexxsupport');return;Include_Lib: procedure Expose system.;parse arg lib, prio;if right(upper(lib), 8)~='.LIBRARY' then lib = lib'.library';if prio='' then prio = 0;if ~show('l', lib) then if ~addlib(lib, prio, -30, 0) then call Quit(20, 'Could not open' lib'!!!');return;IOerr:;signal off ioerr;return_code = 20;error_line = sigl;error_msg = 'IO-error' rc 'at line' sigl '['errortext(rc)']');rc = 0;signal Exit;Log: procedure Expose system.;parse arg text, pre, level
  14. if ~datatype(level, 'N') then level = system.prg.loglevel;tmp = word('PRG MM', (pre~='')+1);text = system.tmp.logpre || pre' 'text;MM_WriteLog 'text' level;return;Quit:;parse arg return_code, error_msg;error_line = 0;rc = 0;signal Exit;Read_Cfg: procedure Expose config. system.;MM_ReadStem system.prg.cfg 'cfg';if RC~=0 then call Quit(31, 'Unable to read' system.prg.cfg'!!!');call Log('Reading config...');cnt = 0;entry = 0;do l=0 to cfg.count-1;parse value strip(translate(cfg.l, ' ', '9'x)) with key args ';' .;key = upper(strip(key));args = strip(args);select;when key='' then iterate;when key='#GATEENTRY' then do;entry = entry+1;config.entry.label = args;end;when key='ONEAREA' then config.entry.onearea = args;when key='ONEADDRESS' then config.entry.oneaddress = args;when key='ONEFLAGS' then config.entry.oneflags = upper(args);when key='ONETO' then config.entry.oneto = args;when key='ONEFROM' then config.entry.onefrom = args;when key='ONESUBJECT' then config.entry.onesubject = args
  15. when key='TWOAREA' then config.entry.twoarea = args;when key='TWOADDRESS' then config.entry.twoaddress = args;when key='TWOFLAGS' then config.entry.twoflags = upper(args);when key='TWOTO' then config.entry.twoto = args;when key='TWOFROM' then config.entry.twofrom = args;when key='TWOSUBJECT' then config.entry.twosubject = args;when key='ORIGIN' then config.entry.origin = args;otherwise say '*** CFG-ERROR: Unknown keword "'key'" at line' l'!!!';end;cnt = cnt+1;end;if entry = 0 then Quit(20,'No #GATEENTRY found!! You need at least one!');config.count = entry;return;Replace: procedure;parse arg string, new, old;do while index(string, old) ~= 0;interpret "parse var string l '"old"' r";string = l || new || r;end;return string;Syntax:;signal off syntax;return_code = 40;error_line = sigl;error_msg = 'Syntax-error' rc 'at line' sigl '['errortext(rc)']';rc = 0;signal Exit;Usage:;rx. = '';rx.0.0 = '[rx] ';rx.0.1 = '[.rexx]';m = pos('/e', system.prg.ver)>0;say
  16. say 'Usage:' rx.m.0 || system.prg.name || rx.m.1 system.cmdopts;say;call Quit(0, 'Usage requested.');ShoveMsgs: procedure Expose config. system.;parse arg entry;call Log();call Log('Currently Gating Nº 'right(entry,2)': 'config.entry.label);call Log();drop MSGS.;drop RMSG.;drop WMSG.;if ((config.entry.oneflags = 'READONLY') & (config.entry.twoflags = 'WRITEONLY')) | ((config.entry.oneflags = 'TWOWAY') & ((config.entry.twoflags = 'TWOWAY') | (config.entry.twoflags = 'WRITEONLY')) ) then do;call Log('Searching for messages to gate in 'config.entry.onearea);MM_SearchMsgs config.entry.onearea MSGS '"'config.entry.onefrom'"' '"'config.entry.oneto'"' '"'config.entry.onesubject'"' !SENT IMP;if RC = 4 then Quit(20, 'Configured area one doesn''t exist!');if MSGS.COUNT > 0 then do;call Log('... 'MSGS.COUNT' messages to gate');do i = 0 to MSGS.COUNT-1;MM_ReadMsg config.entry.onearea MSGS.i RMSG;call open(fh,system.tmpfile,'W');writeln(fh,'1'x'DATED: 'RMSG.DATE);do j = 0 to RMSG.TEXT.COUNT-1;writ
  17. eln(fh,RMSG.TEXT.j);end
  18. writeln(fh,(Replace(RMSG.FOOT.0, '-+- ', '--- ')));writeln(fh,(Replace(RMSG.FOOT.1, ' # Origin: ', ' * Origin: ')));call close(fh);WMSG.FROM = RMSG.FROM;WMSG.FROMADDR = config.entry.twoaddress;WMSG.TO = RMSG.TO;WMSG.TOADDR = '';WMSG.SUBJ = RMSG.SUBJ;WMSG.TEAR = system.prg.id;WMSG.ORIGIN = config.entry.origin;WMSG.FLAGS = RMSG.FLAGS;WMSG.FILE = system.tmpfile;MM_WriteMsg config.entry.twoarea WMSG;end;end;else call log('No messages to gate');end;if ((config.entry.twoflags = 'READONLY') & (config.entry.oneflags = 'WRITEONLY')) | ((config.entry.twoflags = 'TWOWAY') & ((config.entry.oneflags = 'TWOWAY') | (config.entry.oneflags = 'WRITEONLY')) ) then do;call Log('Searching for messages to gate in 'config.entry.twoarea );MM_SearchMsgs config.entry.twoarea MSGS '"'config.entry.twofrom'"' '"'config.entry.twoto'"' '"'config.entry.twosubject'"' !SENT IMP;if RC = 4 then Quit(20, 'Configured area two doesn''t exist!');if MSGS.COUNT > 0 then do;call Log('... 'MSGS.COUNT' messages to gate');do i = 
  19. 0 to MSGS.COUNT-1
  20. MM_ReadMsg config.entry.twoarea MSGS.i RMSG;call open(fh,system.tmpfile,'W');writeln(fh,'1'x'DATED: 'RMSG.DATE);do j = 0 to RMSG.TEXT.COUNT-1;writeln(fh,RMSG.TEXT.j);end;writeln(fh,(Replace(RMSG.FOOT.0, '-+- ', '--- ')));writeln(fh,(Replace(RMSG.FOOT.1, ' # Origin: ', ' * Origin: ')));call close(fh);WMSG.FROM = RMSG.FROM;WMSG.FROMADDR = config.entry.onearea;WMSG.TO = RMSG.TO;WMSG.TOADDR = '';WMSG.SUBJ = RMSG.SUBJ;WMSG.TEAR = system.prg.id;WMSG.ORIGIN = config.entry.origin;WMSG.FLAGS = '';WMSG.FILE = system.tmpfile;MM_WriteMsg config.entry.onearea WMSG;end;end;else call log('No messages to gate');end;address command 'delete >NIL: 'system.tmpfile;return
  21. /* Original script: 404 lines, 12561 bytes */
  22.